00100	C***** BEAMS,  XNOTE, BAUTO, UPDATE, SLEND, POSIT *******
00200		SUBROUTINE BEAMS
00300		INTEGER UPDN
00400		COMMON/XRN/RN(2000)
00500		COMMON/RINP/R(10,80),POSNT(0/99) /RMOD/RMODE2,SET4,IBEAM,
00600		1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,IT,POS
00700		1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
00800		1 /PTR/PWDS(250),ITEM,LL,IS,IX
00900		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
01000		COMMON R2,JAZ,CENTR,JBZ,RJQ(20),JQ(20) /STF/RSTFAC(8),RSTJ2
01100		COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
01200		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
01300		1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
01400		DATA BX/25./,BY/.5/,DFAC/6./,CURV/0.9/
01500	C  THESE ARE USED TO DETERMINE CURVE OF SLURS AT 63 (21700)
01600	
01700		IF(RMODE.LT.500)GO TO 251
01800		IF(MODE.EQ.4)RETURN
01900	C  PICKS UP SLURS ONLY WHEN USING SUBR. 'EXTRA' *********
02000	251	INVT=-1
02100		IF(MODE.EQ.3)GO TO 25
02200		IF(REND.NE.0)GO TO 25
02300		REND=3
02400	25	DO 1500 K=1,72
02500		IF(INP(K).EQ.'B')GO TO 22
02600	C  B=AUTOMATIC BEAMS.
02700		IF(INP(K).NE.'*')GO TO 1500
02800	15	INP(72)='*'
02900		GO TO 500
03000	1500	IF(INP(K).EQ.ISEMI)GO TO 500
03100		GO TO 15
03200	C ABOVE FOR 2ND LNE OF INPUT. IF LNS ENDS WITHOUT * OR ;, IT PUTS IN *
03300	22	REREAD F78F,A,B,C
03400	C  TYPE '2B' OR '3B' ETC. FOR AUTOMATIC BEAMS. (2=DUPLE  3=TRIPLE)
03500		IF(IREAD.NE.-1)GO TO 1122
03600		A=B
03700		B=C
03800	C  IREAD=-1 WHEN READING SOS FILES. (=-2 WITH ET FILES.)
03900	1122	A=A/2.
04000	C  '2'=1  '3'=1.5   '2B 3;'  MEANS THERE'S A 3 NOTE PICK-UP.
04100		IF(STEM)STEM=0
04200	C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
04300		K=0
04400		N=0
04500		J=0
04600		INP(72)='*'
04700	C  PICKS UP RHYTHM FROM TIME WHEN MODE=2 (NOW IT =4)
04800		IF(B.EQ.0)GO TO 122
04900		K=B
05000		B=0
05100		C=0
05200		DO 2122 NN=1,K
05300		IF(V(NN))GO TO 3122
05400		B=B+1
05500	C  UPDATE COUNTER
05600		GO TO 2122
05700	3122	N=N+1
05800	C TO SKIP OVER RESTS
05900	2122	C=C+ABS(V(NN))
06000		IF(B.LE.1)GO TO 122
06100		IF(C.GT.A)GO TO 122
06200	C SKIPS IF PICK-UP HAS LONGER TOTAL THAN BEAM RANGE (A)
06300		J=2
06400		VX(1)=1
06500		VX2=B
06600	C  PUTS BEAM ON PICK-UP IF MORE THAN ONE NOTE.
06700	122	K=K+1
06800		L=K
06900	222	C=ABS(V(K))
07000		IF(C.EQ.4./88.)GO TO 522 
07100	C  CATCHES 88TH NOTES (GRACE NOTES)???
07200		IF(V(K).GT.0)GO TO 922
07300	1022	N=N+1
07400	C  SUBTRACTS NUMB. FOR REST.
07500		IF(C.GE.A)GO TO 1222
07600	1322	L=L+1
07700		GO TO 422
07800	1222	IF(AMOD(C,A).NE.0)GO TO 622
07900		IF(K-L.LE.1)GO TO 522
08000		L=L+1
08100		GO TO 722
08200	922	IF(C.EQ.A)GO TO 522
08300		IF(C.GE.1)L=L+1
08400	422	IF(K.EQ.IRHY)GO TO 322
08500		K=K+1
08600	5022	B=V(K)
08700		IF(B.NE.4./88.)GO TO 2022
08800		JMP=K
08900	3022	IF(V(K+1).NE.4./88.)GO TO 4022
09000	C  TO BEAM GRACE NOTES WHEN IN AUTOMATIC MODE.
09100		K=K+1
09200		GO TO 3022
09300	C  GO BACK FOR MORE
09400	4022	IF(K.EQ.JMP)GO TO 422
09500	C  GO AWAY IF THERE IS ONLY ONE GRACE NOTE.
09600		CALL BAUTO(J,JMP,K,N)
09700	C  I HOPE THE ARGS. ARE OK!
09800		IF(JMP.EQ.L)L=K
09900	C DOES GRACE NOTE BEAM COME UNDER BIG BEAM(JMP≠L) OR NOT(JMP=L).?
10000		GO TO 422
10100	2022	C=C+ABS(B)
10200		IF(B.GT.0)GO TO 1922
10300		IF(-B.LT.A)GO TO 1022
10400	C GO BACK TO PUT A REST UNDER A BEAM.
10500		N=N+1
10600	C  UPDATE REST COUNTER IF IT GETS TO HERE.
10700	1922	IF(C.LT.A-.0001)GO TO 422
10800		IF(C.LT.A+.0001)GO TO 722
10900	C  .0001 FOR ROUNDOFF PROBLEMS
11000		C=AMOD(C,A)
11100		IF(K-L.LE.1)GO TO 622
11200		CALL BAUTO(J,L,K-1,N)
11300	622	L=K
11400		IF(ABS(V(K)).GE.A)GO TO 77
11500		IF(C.NE.0)GO TO 422
11600	77	L=L+1
11700		GO TO 422
11800	722	IF(K.EQ.L)GO TO 522
11900	1722	DO 1422 IT=L,K
12000		B=V(IT)
12100		IF(B.EQ.4./6.)GO TO 1522
12200		IF(B.EQ..875)GO TO 1422
12300	C .875=(8..)
12400		IF(B.GT..75)GO TO 1522
12500	1422	CONTINUE
12600	C WON'T PUT BEAMS WHERE NOT LOGICAL. CATCHES QUINTS AND SEXT'S.
12700		IF(V(L)+V(K).LT.A+.0001)CALL BAUTO(J,L,K,N)
12800	C  DOES ONLY DUPLES AT THIS POINT.
12900	522	IF(K.LT.IRHY)GO TO 122
13000	
13100	322	IF(J.EQ.0)RETURN
13200	C  NO BEAMS - SO GO BACK.
13300		DO 822 K=J+1,50
13400	C  USES ONLY 68 SLOTS IN 'V'
13500	822	VX(K)=0
13600		J=0
13700		GO TO 511
13800	1522	IF(IT-1.GT.L)GO TO 1622
13900	1822	L=IT+1
14000		IF(L.LT.K)GO TO 1722
14100		GO TO 522
14200	1622	CALL BAUTO(J,L,IT-1,N)
14300		GO TO 1822
14400	C  ALL THIS ↑↑ FOR QUARTERS IN TRIPLE TIME UNITS!
14500	CC27	DO 26 L=1,50
14600	CC26	VX(L)=V(L)
14700	C  BECAUSE MODE 3 IS NOW ACCENTS, ETC.
14800	CC	GO TO 511
14900	
15000	500	REREAD F78F,VX
15100		IF(MODE.EQ.5)NTC=NTC-1
15200	C  NTC=NUM OF NTS NOW
15300		J=0
15400		IF(IREAD.EQ.-1)J=1
15500	C  SKIPS LINE #S IN SOS FILES. (=-2 IS FOR ET FILES.)
15600	511	J=J+1
15700		N=VX(J)
15800		JMP=1
15900	505	L=0
16000		K=0
16100		POS=-10.
16200		IF(MODE.EQ.3)GO TO 5032
16300	C  MODE 3 IS FOR ACCENTS ETC.
16400		RN(8+IS)=0
16500		RN(9+IS)=0
16600		IT=0
16700		UPDN=0
16800		IF(MODE.EQ.5)GO TO 104
16900		IF(STEM.EQ.0)GO TO 503
17000	C  UPDN=2=STEMS DOWN, (SLUR DIP UP)  =1, OPPOSITE.
17100	104	JA=J+1
17200		B=VX(JA)
17300	C THE 2ND NOTE (-=DIP DOWN ALWAYS; +100=UP ALWAYS, ORD.=AUTOMATIC)
17400		IF(B.LT.100)GO TO 512
17500		UPDN=2
17600		B=B-100
17700		IF(B.GT.100)B=100-B
17800	C  TYPE -NUM OR 200+NUM FOR DIP DOWN.
17900	512	IF(B)UPDN=1
18000		VX(JA)=B
18100		IF(MODE.EQ.4)GO TO 503
18200		BRK=AMOD(VX(J),1.)*10.
18300		IF(BRK.EQ.0)GO TO 503
18400	C NEXT FOR TRIPL. BRACKET, ETC.  ADD DESIRED .NUM TO 1ST NUM.
18500		RN(9+IS)=BRK+.0001
18600		GO TO 5030
18700	503	IF(N.GT.0)GO TO 5031
18800		IT=-1
18900	C6/75	POS=-1.3
19000		CALL SLEND
19100	C  -1= SLUR INTO 1ST NOTE.
19200	C  SETS POS OF LFT SIDE (-10+9, THEN +2)
19300		GO TO 5060
19400	5031	IF(N.LE.NTC)GO TO 5030
19500	C  NTC=NUM OF NTS
19600	C6/75	POS=202
19700		CALL SLEND
19800	C  SLEND CHECKS ON END POINTS OF THIS STAFF
19900		GO TO 504
20000	C  -1=1ST SLUR FROM NO NOTE; 99= LAST, TO NO NOTE
20100	5032	IF(N.GT.IRHY)N=IRHY
20200	C TRAPS ERROR OF TRYING TO PUT MARK ON NON-EXISTENT NOTE.
20300	5030	L=L+1
20400	502	K=K+1
20500		IF(R(1,K).NE.1.)GO TO 502
20600	C  IS IT A NOTE?
20700		P=R(3,K)
20800		IF(P.EQ.POS)GO TO 502
20900	C  SKIPS DBLSTPS
21000		POS=P
21100	506	IF(L.LT.N)GO TO 5030
21200	5060	IF(MODE.EQ.3)GO TO 30
21300	C  NOW SLUR STARTS
21400		IF(JMP)GO TO 504
21500	C  JMP=-1 MEANS END NOTE OF GROUP
21600		J=J+1
21700		NN=VX(J)
21800	C  IF 2ND NUM IS .LE. 1ST , THEN 2-NOTE SLUR. (-1 GOES TO 1)
21900		IF(NN.EQ.0)NN=N+1
22000		IF(NN.EQ.0)NN=1
22100		IF(NN)GO TO 777
22200		IF(NN.LE.N)NN=N+1
22300	C  FOR USE WITH AUTO-BEAMS OR DIP UP.  2-NOTE SLUR OR BEAM UP.
22400	CC777	IF(STEM)GO TO 5061
22500	777	IF(MODE.NE.4)GO TO 5061
22600	CC	IF(MODE.NE.4)GO TO 177
22700		IF(STEM.LE.0)GO TO 5061
22800	C  AUTOMATIC DIP DIRECTION FOR SLURS WITH AUTO. BEAMS.
22900	177	MK=K
23000	877	IF(R(1,MK).EQ.1)GO TO 477
23100		MK=MK+1
23200		GO TO 877
23300	C  FOR SLUR INTO FIRST NOTE WITH AUTO BEAMS.
23400	477	A=19.-R(5,MK)
23500		IF(NN.GE.0)GO TO 277
23600		IF(A.GT.0)GO TO 377
23700	277	IF(A.GE.0)GO TO 5061
23800		IF(NN.LE.0)GO TO 5061
23900	377	NN=-NN
24000	5061	MK=N
24100		N=IABS(NN)
24200		M=K
24300		JA=3
24400		JB=4
24500		KN=K
24600		RB=0
24700		IF(MODE.EQ.4)GO TO 550
24800		IBR=6
24900	C  6=SLUR, 7=BRACK. FOR TRIPLETS, ETC.
25000	CC*** NOT NEEDED NOW WITH UPDN FEATURE.	IF(STEM.GE.0)NN=-NN
25100		IF(IT)GO TO 550
25200	C  IT=-1=SLUR INTO 1ST NOTE.
25300		A=XNOTE(K)
25400	C XNOTE IS AMOD(R(4,K),100.)
25500	C  SAVES LEVEL OF 1ST NOTE.
25600	504	RB=2
25700		B=AMOD(R(6,K),1.0)
25800		IF(B.GE.0.5)RB=3.
25900		IF(B.EQ.0.4)RB=5.
26000	C   THESE ARE FOR >(.5) AND ∧(.4) ACCENTS
26100		IF(NN)RB=-RB
26200	C  DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
26300	550	RN(JA+IS)=POS
26400		B=XNOTE(K)
26500		IF(MODE.EQ.4)GO TO 519
26600	C  TO MAKE MINI-BEAMS ON GRACE NOTES WHEN NEEDED.
26700		IF(MODE.NE.5)GO TO 513
26800		SLUR=0
26900	C A FLAG FOR LATER USE.
27000		MB=R(5,K)/10.
27100	CC	IF(JMP.GE.0.AND.UPDN.EQ.0)GO TO 515
27200		IF(UPDN.EQ.0)GO TO 515
27300		IF(MB.EQ.0)MB=UPDN
27400	C  MB=0 IF 2ND NOTE IS WITHOUT STEM
27500		IF(MB.EQ.UPDN)GO TO 515
27600		X=6
27700		IF(RB)X=-X
27800		RB=RB+X
27900		JA=3
28000		IF(JMP)JA=6
28100		IF(RB)GO TO 204
28200		IF(UPDN.EQ.2)GO TO 516
28300	204	IF(UPDN.EQ.1)GO TO 516
28400	C  ABOVE FOR VARIOUS COMBINATIONS OF STEM DIRECTIONS
28500		RB=-RB
28600		NN=-NN
28700	516	IF(K.GT.1)GO TO 16
28800		IF(IT)GO TO 513
28900	16	IF(K.NE.NTC)GO TO 116
29000		IF(N.GT.NTC)GO TO 513
29100	C JUMP IF N=99, BY PASS IF K IS NOT LAST NOTE OF LINE.
29200	116	SLUR=1.
29300		IF(UPDN.EQ.1)SLUR=-SLUR
29400		SLUR=SLUR*RSTJ2
29500		RN(JA+IS)=RN(JA+IS)+SLUR
29600	C  THIS NOT DONE IF SLUR TO FIRST NOTE
29700		GO TO 513
29800	CC519	B=R(4,K)
29900	519	A=R(10,K)
30000		IF(A.EQ.0)GO TO 513
30100	C JUMP IF IT'S NOT ON DIFF STF.
30200		RA=RSTJ2*2.44
30300	C  NOTE WIDTH
30400	CC	IF(ABS(B).GE.100)RA=RA*.6
30500		IF(ABS(R(4,K)).LT.80)GO TO 520
30600		RA=RA*.6
30700		IF(JMP)B=B-100
30800	C  MINI
30900	520	IF(A.EQ.2)RA=-RA
31000	C  STAFF ABOVE
31100		RN(JA+IS)=POS+RA
31200	C  ***** THIS CAN BE OFF A LITTLE IN SOME CASES!!******
31300		GO TO 513
31400	
31500	
31600	517	IF(MB.EQ.1)GO TO 513
31700		IF(RB)RB=-RB
31800		GO TO 518
31900	515	UPDN=MB
32000	C AUTO SLUR DIP DEPENDS ON STEM DIREC. OF 1ST NOTE. (WHOLE NTS??)
32100		IF(NN)GO TO 517
32200		IF(MB.NE.1)GO TO 513
32300		RB=-RB
32400	518	NN=-NN
32500	513	RN(JB+IS)=B+RB
32600	C  MK=# OF 1ST NOTE, N=END NOTE NOW
32700		JMP=-JMP
32800		IF(JMP.GT.0)GO TO 1503
32900	C  GO FIND RT. SIDE OF SLUR
33000		JA=6
33100		JB=5
33200		IF(N.LE.MK)N=MK+1
33300	C  PICKS UP TYPO ERRORS
33400		JK=0
33500		IF(R(7,K).GE.10)JK=-1
33600	C  CHECKS FOR DOT AFTER 1ST NOTE -- FOR TIES.
33700		GO TO 503
33800	
33900	1503	RN(2+IS)=STAFF
34000		IF(MODE.EQ.4)GO TO 35
34100		RN(8+IS)=-1
34200		RN(1+IS)=5
34300		IF(IT)RN(4+IS)=RN(5+IS)
34400		NN=-NN
34500	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
34600		IF(MK.EQ.IRHY)GO TO 61
34700		IF(N.EQ.1)GO TO 61
34800	CC	IF(((XNOTE(K).NE.A.OR.N-MK.GT.1).AND.IT.GE.0.
34900	CC	1 ).OR.IT)GO TO 60
35000		IF(IT)GO TO 60
35100		IF(XNOTE(K).NE.A)GO TO 60
35200		IF(N-MK.GT.1)GO TO 60
35300	CCC	IF(R(5,M).NE.R(5,K))GO TO 65
35400	CCC  FOR SLUR OVER CHROMATIC CHANGE ON SAME NOTE NAME.
35500	C  M=1ST NOTE OF SLUR, K=LAST
35600		IF(AMOD(R(5,K),10.0).GT.0)GO TO 65
35700	C  JUMP IF LAST NOTE AS ACCI.
35800	C  JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
35900	61	C=9
36000		IF(JK)C=12
36100		IF(RN(6+IS)-RN(3+IS)-C*RSTJ2)GO TO 65
36200	C  JUMP IF SLUR IS VERY SHORT
36300		IF(IT)A=XNOTE(K)
36400	C  IT=-1=SLUR INTO 1ST NOTE.
36500		A=A+.7
36600		IF(NN.GT.0)A=A-1.4
36700	C  TO RAISE OR LOWER IT .5
36800		RN(4+IS)=A
36900		RN(5+IS)=A
37000		B=-2
37100		IF(JK)B=-3
37200	C  JK=-1 WHEN NOTE IS DOTTED.
37300	C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
37400		RN(8+IS)=B
37500		IF(SLUR.EQ.0)GO TO 65
37600		RN(3+IS)=RN(3+IS)-SLUR
37700		RN(6+IS)=RN(6+IS)-SLUR
37800	C  PUSH SLUR BACK TO WHERE IT WAS
37900		GO TO 65
38000	
38100	C** 6/16/75 60	IF(STEM.GE.0)GO TO 508
38200	60	IF(STEM.GE.0)GO TO 200
38300		IF(MODE.EQ.5)GO TO 200
38400	C  JUMP IF SLURS**************
38500	C  NEXT IS STEM INVERTER.  SKIP IF AUTOMATIC BEAMS OR 'SU' 'SD' IN USE.
38600		JB=1
38700		RB=10.
38800		IF(NN)GO TO 509
38900	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
39000		RB=-RB
39100		JB=2
39200	509	DO 507 L=M,K
39300		IF(R(1,L).NE.1.)GO TO 507
39400		JA=R(5,L)/10.
39500		IF(JA.NE.JB)GO TO 507
39550		IF(R(10,L).NE.0)GO TO 507
39560	C LEAVE NOTE ON OTHER STAFF ALONE.
39600		R(5,L)=R(5,L)+RB
39700		INVT=0
39800	C**********************************************
39900	507	CONTINUE
40000	CC508	IF(N.GT.100)GO TO 514
40100	C**** NO LONGER USED.  USE 'SD' 'SU' **  JUMP IF ONLY REVERSING STEMS.
40200		GO TO 200
40300	62	IF(NN)GO TO 64
40400		IF(A.EQ.DMAX)GO TO 65
40500		AA=B-DMAX
40600		GO TO 63
40700	65	AA=0
40800		GO TO 63
40900	64	IF(A.EQ.UMAX)GO TO 65
41000		AA=UMAX-B
41100	63	RA=RN(6+IS)
41200		RB=RN(3+IS)
41300		X=CURV+(RA-RB)/BX+ABS(RN(4+IS)-RN(5+IS))/10.
41400	C  CURVE DEPENDS ON LENGTH, TILT AND NOTES BETWEEN.
41500		IF(AA.GT.0)X=X+AA*BY
41600		IF(BRK.EQ.0)GO TO 66
41700		RN(8+IS)=1
41800		RN(3+IS)=RB-.6
41900		RB=R(3,K+1)
42000	C  K=END NOTE OF GROUP
42100		IF(K.EQ.IRHY)RB=200.
42200	C  ASSUMES LINE STOPS AT 200. (IT COULD BE LONGER!!)
42300		RN(6+IS)=RA+(RB-RA)/2.
42400		IBR=7
42500	C  CHECK THESE NUMBERS↑↑↑↑
42600		B=RN(4+IS)
42700		BB=RN(5+IS)
42800		RA=1
42900		IF(A.LT.-1)RA=2.5
43000	C  CHANGES HEIGHT.  MAKES BRACK. IF N>100.
43100		IF(NN.GT.0)RA=-RA
43200		RN(4+IS)=B+RA
43300		RN(5+IS)=BB+RA
43400		X=2
43500	66	IF(NN.GT.0)X=-X
43600	510	RN(7+IS)=X
43700		IF(MODE.NE.4)GO TO 2514
43800		RN(9+IS)=0
43900		RN(10+IS)=0
44000		RN(IS+11)=-1
44100		CALL UPDATE(9)
44200		IF(JB)CALL BMX(RA)
44300		GO TO 514
44400	2514	L=IS
44500		CALL UPDATE(IBR)
44600		IF(M.EQ.K)GO TO 514
44700	C JUMP OUT IF INTERVENING NOTE.
44800		IF(RN(L+4).NE.RN(L+5))GO TO 514
44900	C  IS IT LEVEL?
45000		B=-RN(IS-2)
45100	C CHANGE DIRECTION OF DIP AFTER FIRST SLUR.
45200		RA=1.4
45300		IF(RN(L+8).EQ.-1)RA=RA+1.3
45400	C  IS TIE NOT BETWEEN NOTES?
45500		IF(NN.GT.0)RA=-RA
45600	C DIP DIRECTION.  NN+ =DOWN, NN- =UP.  REVERSED AFTER 1ST ONE.
45700	CC	RA=R(4,M)+RA
45800		RA=XNOTE(M)+RA
45900		C=-2.
46000		IF(RN(L+8).EQ.-3.)C=-3.
46100	C PUT TIE BETWEEN NOTES ALWAYS.
46200		JA=M
46300		JB=K
46400	114	JA=JA+1
46500		JB=JB+1
46600		IF(R(1,JA).NE.1)GO TO 514
46700	C  CATCHES THINGS BETWEEN NOTES
46800		IF(R(4,JA).NE.R(4,JB))GO TO 514
46900	C  LOOKS FOR  PARALLEL CHORDS NOTES
47000		IF(R(9,JA)+R(9,JB).NE.0)GO TO 514
47100	C  MAKES SURE THEY ARE CHORD NOTES.
47200	CC	A=R(4,JA)-RA+RN(L+5)
47300		A=XNOTE(JA)-RA+RN(L+5)
47400		RN(IS)=6.
47500		RN(IS+1)=5.
47600		RN(IS+2)=RN(IS-7)
47700		RN(IS+3)=RN(IS-6)
47800		RN(IS+6)=RN(IS-3)
47900		RN(IS+7)=B
48000		RN(IS+8)=C
48100		RN(IS+4)=A  
48200		RN(IS+5)=A  
48300		CALL UPDATE(IBR)
48400		GO TO 114
48500	514	J=J+1
48600		A=VX(J)
48700		N=A
48800	C  SO ITEMS NEED NOT BE IN RIGHT ORDER.
48900		IF(MOD(N,100).GT.IRHY)A=0
49000		IF(A.NE.0)GO TO 505
49100		IF(J.LT.50)GO TO 514
49200	C  SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
49300		IF(INP(72).NE.'*')GO TO  552
49400		IF(INVT)RETURN
49500		INVT=IS
49600		CALL NEWR
49700		IS=INVT
49800		RETURN
49900	552	IF(IREAD.NE.0)GO TO 3501
50000		CALL TYPE
50100		WRITE(21,4501)INP
50200		GO TO 5501
50300	3501	IF(IREAD.EQ.-1)READ(22,2501)J,INP
50400		IF(IREAD.EQ.-2)READ(22,4501)INP
50500	5501	CALL LNEND
50600	C  FOR NEW 'SCORE' CONVENTIONS
50700	C  TO READ MORE THAN 2 LINES.
50800		GO TO 25
50900	C  FOR 2ND LINE.
51000	4501	FORMAT(72A1)
51100	2501	FORMAT(I,72A1)
51200	
51300	
51400	35	RA=10.
51500	C  RA WILL=# OF TAILS,  KN=1ST NOTE, K=LAST ('MOD' FOR DOTTED NOTES.)
51600		RN(1+IS)=6
51700		JMAX=0
51800		IF(N-MK.EQ.1)JMAX=-1
51900		DMAX=100.
52000		UMAX=-DMAX
52100	C  FOR AUTO. BEAMS
52200	
52300		JB=0
52400		MB=0
52500	C MB=-1 =GRACE NOTES UNDER BEAMS.  
52600		IF(ABS(R(4,KN)).GE.80.)MB=-1
52700		DO 2 L=KN,K
52800		IF(R(1,L).NE.1)GO TO 2
52900		BB=R(5,L)
53000		IF(BB.GE.10.)GO TO 12
53100		UPDN=-1
53200	CC	IF(R(10,L).EQ.0)NN=19.-AA
53300		NN=19-AA
53400	CHORDS WILL HAVE FIXED STEM DIRECTIONS ALWAYS
53500		GO TO 2
53600	C  SKIPS NON-NOTES AND DBLSTPS
53700	12	IF(MB)GO TO 10
53800		AA=BB
53900		RB=R(4,L)
54000		IF(ABS(RB).GE.80)GO TO 2
54100	C  SKIPS GRACE NOTES
54200		GO TO 110
54300	10	RB=XNOTE(L)
54400	110	IF(RB.GT.UMAX)UMAX=RB
54500		IF(RB.LT.DMAX)DMAX=RB
54600	C  FOR AUTO. BEAMS
54700		RB=AMOD(R(7,L),10.0)
54800	112	IF(RA.EQ.RB)GO TO 2
54900		JB=-1
55000	C   FLAG FOR MIXED NUM. OF BEAMS
55100		IF(RB.GE.RA)GO TO 2
55200		IF(RB.NE.0)RA=RB
55300	2	CONTINUE
55400	C  ABOVE FINDS SMALLEST # OF TAILS.  NEXT FOR HGTS.
55500	C  ABOVE IS POS.2
55600		IT=K
55700	C  FOR EXTRA BEAMS WITH CHORDS. SAVE IT IN "IT"
55800		IF(STEM.GT.0)GO TO 577
55900	C  *****↑↑↑↑↑↑ ABOVE WAS ".NE." BEFORE 4/30/76. WHY?#@&Xαε
56000		IF(UPDN.NE.0)GO TO 577
56100		IF(UMAX+DMAX.GE.14)NN=-1
56200	CXX	IF(STEM.GT.0)NN=10.-STEM
56300	C  SETS AUTO. BEAMS' STEM DIRECTION.
56400	577	X=10
56500		IF(NN)X=20
56600		IF(MB)RA=2
56700	C  2 BEAMS ON GRACE NOTES ALWAYS
56800		X=X+RA
56900	C  # OF BEAMS.  IT'S PUT IN  DOWN BELOW 550.
57000	200	M=KN
57100	207	L=M+1
57200		IF(R(1,L).NE.1)GO TO 307
57300		IF(R(9,L).NE.0)GO TO 307
57400		M=M+1
57500		GO TO 207
57600	C  FOR HEIGHTS OF DBL STPS, ETC.
57700	307	A=XNOTE(M)
57800	C   A=NOTE 1.
57900		UMAX=A
58000		DMAX=A
58100	C  UP MAX. NOTE #, DOWN MAX. NOTE #.
58200	407	M=K+1
58300		IF(R(1,M).NE.1)GO TO 103
58400		IF(R(9,M).NE.0)GO TO 103
58500	C  FINDS DBL+ STP ON LAST OF BEAM
58600		K=M
58700		GO TO 407
58800	103	DO 3 M=KN,K
58900		IF(R(1,M).NE.1)GO TO 3
59000		IF(M.EQ.K)GO TO 107
59100		IF(R(10,M).NE.0)GO TO 107
59200		IF(R(9,M+1).EQ.0)GO TO 3
59300	C  IGNORE LOWER (OR UPPER) NOTES OF CHORDS - IN RE. UP-DOWN FEATURE.
59400	107	IF(MB)GO TO 7
59500	C  SKIP IF DEALING WITH GRACE NOTE BEAMS. (MB=-1)
59600		IF(ABS(R(4,M)).GE.100)GO TO 3
59700	C  SKIPS NON-NOTES
59800	7	B=XNOTE(M)
59900	CC	IF(STEM.GT.0)GO TO 55
60000	CC	IF(MODE.NE.5)GO TO 677
60100	CC	IF(STEM.EQ.0)GO TO 55
60200		IF(MODE.EQ.5)GO TO 55
60300	677	Y=R(5,M)
60400	33	IF(NN.GT.0)GO TO 5
60500	C  JUMP IF STEM UP
60600		IF(Y.GE.20.)GO TO 55
60700		IF(Y.LT.10.)GO TO 55
60800		R(5,M)=Y+10.
60900		GO TO  551
61000	5	IF(Y.LT.20.)GO TO 55
61100		R(5,M)=Y-10.
61200	C************************
61300	C    STEM UP
61400	551	INVT=0
61500	55	IF(B.LE.UMAX)GO TO 13
61600	C ↑↑↑↑↑↑↑↑ WAS .LT. !!!!! 5/76
61700		UMAX=B
61800		IF(JMAX)GO TO 3
61900		IF(M.EQ.KN)GO TO 3
62000		IF(M.EQ.K)GO TO 3
62100		UMAX=UMAX+1
62200		GO TO 3
62300	13	IF(B.GT.DMAX)GO TO 3
62400		DMAX=B
62500		IF(JMAX)GO TO 3
62600		IF(M.EQ.KN)GO TO 3
62700		IF(M.EQ.K)GO TO 3
62800		DMAX=DMAX-1
62900	3	CONTINUE
63000	C  LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
63100	4	IF(MODE.EQ.5)GO TO 62
63200		K=IT
63300	C  FOR EXTRA BEAMS WITH CHORDS. K WAS SAVED IN "IT"
63400		AA=A
63500		BB=B
63600		C=1
63700		IF(X.LT.20.)GO TO 48
63800	C  JUMP IF STEM IS UP
63900		CALL EXCH(AA,BB)
64000		C=-C
64100		CALL EXCH(UMAX,DMAX)
64200	48	IF(AA.LT.BB)GO TO 45
64300		IF(UMAX.EQ.A)GO TO 46
64400	47	A=UMAX-C
64500		B=A
64600		GO TO 444
64700	46	IF(UMAX.GT.AA)GO TO 47
64800		GO TO 49
64900	45	IF(UMAX.NE.B)GO TO 47
65000	49	A=AA
65100		B=BB
65200		IF(X.GE.20)CALL EXCH(A,B)
65300	
65400	444	RN(2+IS)=STAFF 
65500	446	DIS=(RN(IS+6)-RN(IS+3))/DFAC
65600	C  FOR TILT LATER -- DFAC IS IN DATA
65700		IF(ABS(A-B).LT.DIS)GO TO 14
65800		C=C*DIS
65900	C  NEW TILT ROUTINE.  CONSIDERS DISTANCE:HEIGHT
66000	C  LIMITS SLOPE OF BEAM
66100		IF(X.GE.20)GO TO 141
66200		IF(B.GT.A)GO TO 140
66300	142	B=A-C
66400		GO TO 14
66500	141	IF(B.GT.A)GO TO 142
66600	140	A=B-C
66700	14	IF(MB.EQ.0)GO TO 143
66800	C NEXT FOR GRACE NOTE BEAMS (MB=-1)
66900		C=100
67000		IF(A)C=-C
67100		A=A+C
67200	143	RN(4+IS)=A
67300		RN(5+IS)=B
67400	C   MAKES HORIZONTAL BEAMS IF PATTERN IS UP-DOWN.
67500	C*******??????	RN(6+IS)=R(3,K)
67600	C  ABOVE IS POS.2
67700		GO TO 510
67800	
67900	C   NEXT IS FOR ACCENTS AND OTHER MARKS
68000	
68100	30	CALL MARKS(RA)
68200		J=J+1
68300		IF(RA.EQ.99)RA=VX(J)
68400	C  IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
68500	C    OF ACCENT WILL BE INVERTED.
68600		IF(RA.LT.40)GO TO 304
68700		NN=6
68800		BB=-6
68900		A=3
69000		B=3
69100		IF(XNOTE(K).LT.3)BB=XNOTE(K)-9.5
69200	C LOWERS ITEM IF NOTE BELOW STAFF.  BUT IS 'K' ALWAYS OK HERE??????
69300		IF(RA.LT.99)GO TO 305
69400	C NEXT FOR CRESC. & DECRSC. LINES<,>. TYPE /NT1 C+ NT2/ OR /N1.d  C- N2.d/
69500		NN=8
69600		BB=BB+2.5
69700		A=5
69800		B=4
69900		RN(IS+7)=RA-200
70000	C  MAKES ZERO OR -1 IN P7
70100		RA=50
70200	C  ADDS A NEW ITEM.  MP, PP, CRESC., ETC. --CODE 3
70300	305	RN(IS)=A
70400		RN(IS+1)=B
70500		RN(IS+2)=STAFF
70600	C  PUTS MF, ETC. BETWEEN NOTES.  (I HOPE)  SEE 'FUNCTION POSIT' BELOW
70700		RN(IS+3)=POSIT(VX(J-1))-1
70800	C  '-1' PUSHES IT TO LEFT. MAYBE CHANGE ORIGINAL POSITIONS??
70900		RN(IS+4)=BB
71000	C  DIST. BELOW STAFF
71100		RN(IS+5)=RA
71200	C  THE CODE NUM IN 'CLEFS' LIST
71300		IS=IS+NN
71400		IF(NN.EQ.6)GO TO 514
71500		J=J+1
71600		RN(IS-2)=POSIT(VX(J))
71700	C  THIS IS P6 (POS2 FOR CRESC. LINES)
71800		GO TO 514
71900	304	RB=R(6,K)
72000		B=10.
72100		IF(RA.EQ.6)RA=26.
72200	C TEMPORARY CHANGE FOR FERMATA*******
72300		IF(RA.GT.10.)RA=RA/10.
72400		A=ABS(AMOD(RB,1.))
72500		IF(A.EQ.0)GO TO 301
72600		IF(RA.GT.3)GO TO 303
72700		RB=FLOAT(IFIX(RB))
72800		RA=RA+A/10.
72900	C  THIS PUTS 2-DIGIT CODE BEFORE 1-DIGIT CODE.
73000		GO TO 301
73100	303	IF(A.LT..3)GO TO 302
73200		B=100.
73300		GO TO 301
73400	302	B=1000.
73500	301	IF(RB.LT.0)RA=-RA
73600		R(6,K)=RB+RA/B
73700		GO TO 514
73800	C   USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
73900	C  NOTE#,ACCENT#/N,A/N,A*
74000		END
74100	
74200	CF	FUNCTION XNOTE(J)
74300	CF	COMMON/XRN/RN(4000)
74400	CF	DIMENSION R(10,80)
74500	CF	EQUIVALENCE (R,RN(3001))
74600	CF	XNOTE=AMOD(R(4,J),100.)
74700	CF	END
74800	
74900	CF	SUBROUTINE BAUTO(J,L,K,N)
75000	C  FOR AUTOMATIC BEAMS.
75100	CF	COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
75200	CF	J=J+2
75300	CF	V(J-1)=L-N
75400	CF	V(J)=K-N
75500	CF	END
75600	
75700	CF	SUBROUTINE UPDATE(I)
75800	CF	COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
75900	CF	RN(IS)=I
76000	CF	IS=IS+I+3
76100	CF	END
76200	
76300	C	SUBROUTINE SLEND
76400	C	INTEGER PWDS
76500	C  TO FIND END POINTS OF STAVES
76600	C	COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,DMAX,
76700	C	1 UMAX,AA,JMAX,X,Y,BB,RNX(1982)
76800	     1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
76900	C	DO 1 K=1,ITEM
77000	C	L=PWDS(K)
77100	C	IF(RN(L+1).NE.8)GO TO 1
77200	C  FOUND A STAFF
77300	C	IF(RN(L+2).NE.STAFF)GO TO 1
77400	C GOT THE RIGHT ONE
77500	C	IF(IT)GO TO 2
77600	C	POS=202
77700	C NOW CHECK LEFT SIDE OF STAFF
77800	C	IF(RN(L).LT.4)RETURN
77900	C P6 WASN'T MENTIONED - SO IT =200
78000	C	POS=RN(L+6)+2
78100	C	IF(POS.EQ.2)POS=202
78200	C	RETURN
78300	C2	POS=RN(L+3)-2.3
78400	C	RETURN
78500	C1	CONTINUE
78600	C	END
78700	
78800	C	FUNCTION POSIT(V)
78900	C	COMMON/XRN/RN(4000)
79000	C	DIMENSION POSNT(0/82)
79100	C	EQUIVALENCE (POSNT,RN(3801))
79200	C	1,(A,RN(3884)),(K,RN(3885))
79300	C	IF(V)V=-V
79400	C  REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
79500	C	K=V
79600	C	A=POSNT(K)
79700	C	POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
79800	C  TYPE  /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
79900	C	END